// utilities for conversion between Perl and C/C++
// (also an alert function)

#include "PlPN.h"

void report_refcount(SV* arg, char* where) {
	Perl_warn_nocontext("%s, refcount of %d is %d", where, (int)arg, SvREFCNT(arg));
}

SV* create_perl_object(void* cpp_ptr, const char* classname) {
	SV* perl_obj;
	
	// store the pointer in an SV
//	SV* rv = newSV(0);
//	sv_setref_pv(
//		rv,				/* target; will be upgraded to reference */
//		Nullch,			/* class; Nullch means do not bless */
//		(void*)cpp_ptr	/* pointer to save */
//	);

	SV* rv = newSViv((IV)cpp_ptr);
	
	// create an HV and store the SV in it
	HV* hv = newHV();
	hv_store(
		hv,			/* target */
		"_cpp_ptr",	/* key */
		8,			/* key length */
		rv,			/* value */
		0			/* hash; 0 means let perl compute */
	);
	
	// get a ref to the HV and bless it into CLASS
	perl_obj = newRV_noinc((SV*)hv);
	sv_bless(
		perl_obj,					/* reference to be blessed */
		gv_stashpv(classname, 1)	/* stash to bless it into */
	);
	
	return perl_obj;
}

void* retrieve_cpp_object(SV* perl_obj) {
	void* cpp_ptr = NULL;
	
	// verify we're an object and a hashref
	if(sv_isobject(perl_obj) && (SvTYPE(SvRV(perl_obj)) == SVt_PVHV)) {
		// get our value from the hash
		SV** val = hv_fetch(
			(HV*)SvRV(perl_obj),	/* target */
			"_cpp_ptr",				/* key */
			8,						/* key length */
			0						/* is this fetch part of a store? */
		);
		if (val != NULL) {
			// get the pointer from the dereferenced values
			// why do we get an IV after setting a PV above?
			// why does this work?
			//
			// I think it works because we set the pointer directly
			// (rather than copying the string), so the SV somehow
			// doesn't know it's a string, so returns the pointer
			// as a number rather than a numerified version of
			// whatever the pointer is pointing to.
//			cpp_ptr = (void*)SvIV((SV*)SvRV(*val));
			cpp_ptr = (void*)SvIV(*val);
		}
	}
	
	return cpp_ptr;
}

extensions::cookie_t code_2_cookie(SV* codesv) {
	// make a big enough buffer
	char code[sizeof(extensions::cookie_t)+1];
				
	// copy the string from the SV*
	STRLEN len = sv_len(codesv);
	if (len > sizeof(extensions::cookie_t)) {
		len = sizeof(extensions::cookie_t);
	}
	memcpy(code, SvPV_nolen(codesv), len);
	
	// pad with nulls
	for (int i=len; i<sizeof(extensions::cookie_t)+1; i++) { code[i] = 0; }
	
	// use that as a numeric value
	return *(extensions::cookie_t*)code;
}

SV* cookie_2_code(extensions::cookie_t cookie) {
	// make a big enough buffer
	char code[sizeof(extensions::cookie_t)+1];
				
	// copy the cookie
	memcpy(code, (void*)&cookie, sizeof(extensions::cookie_t));

	// make sure the last char is a null
	code[sizeof(extensions::cookie_t)] = 0;
	
	return newSVpv(code, 0);	// length of 0 means Perl will use everything up to the first null
}
